PC go! 2008 April/PCgo 2008-04 (DVD).iso/interface/contents/demoversionen_3846/13664/files/Data1.cab/frmsampleprint.frm

Visual Basic Form | 2001-10-16 | 5.7 KB | 190 lines

VERSION 5.00
Begin VB.Form frmSamplePrint
   AutoRedraw      =   -1  'True
   Caption         =   "In process server "
   ClientHeight    =   6630
   ClientLeft      =   2235
   ClientTop       =   1710
   ClientWidth     =   7815
   LinkTopic       =   "Form1"
   PaletteMode     =   1  'UseZOrder
   ScaleHeight     =   6630
   ScaleWidth      =   7815
   Begin VB.CommandButton Command1
      Caption         =   "Refresh"
      Height          =   360
      Left            =   6255
      TabIndex        =   5
      Top             =   2535
      Width           =   1140
   End
   Begin VB.CommandButton Print1
      Caption         =   "Print"
      Enabled         =   0   'False
      Height          =   495
      Left            =   6240
      TabIndex        =   4
      Top             =   1800
      Width           =   1215
   End
   Begin VB.CommandButton Exit
      Caption         =   "Exit"
      Height          =   495
      Left            =   6240
      TabIndex        =   3
      Top             =   5520
      Width           =   1215
   End
   Begin VB.CommandButton SavetoFile
      Caption         =   "Save to File"
      Enabled         =   0   'False
      Height          =   495
      Left            =   6240
      TabIndex        =   2
      ToolTipText     =   "Save editing drawing to new File"
      Top             =   1080
      Width           =   1215
   End
   Begin VB.CommandButton OpenFile
      Caption         =   "Open File"
      Height          =   495
      Left            =   6240
      TabIndex        =   1
      ToolTipText     =   "Add existing file"
      Top             =   240
      Width           =   1215
   End
   Begin VB.PictureBox Frame1
      AutoRedraw      =   -1  'True
      AutoSize        =   -1  'True
      BackColor       =   &H80000009&
      Height          =   5745
      Left            =   360
      MousePointer    =   2  'Cross
      ScaleHeight     =   379
      ScaleMode       =   3  'Pixel
      ScaleWidth      =   363
      TabIndex        =   0
      Top             =   255
      Width           =   5505
   End
Attribute VB_Name = "frmSamplePrint"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************'
'*                                                                *'
'*                      TurboCAD for Windows                      *'
'*                   Copyright (c) 1993 - 2001                    *'
'*             International Microcomputer Software, Inc.         *'
'*                            (IMSI)                              *'
'*                      All rights reserved.                      *'
'*                                                                *'
'******************************************************************'
Option Explicit
Private Sub Command1_Click()
    Frame1.Refresh
    Vi.Refresh
End Sub
Private Sub OpenFile_Click()
    On Error GoTo ErrorHandler
    'open cad file and create graphics object
Dim CadFile As String
    CadFile = App.Path & "\testcad.tcw"
    Set Dr = Drs.Open(CadFile)
    Set Bls = Dr.Blocks ' Blocks collection
    Set Vis = Dr.Views
    Set Vi = Vis.Add(, Frame1.hDC)
    Vi.ScreenTop = Frame1.ScaleTop
    Vi.ScreenLeft = Frame1.ScaleTop
    Vi.ScreenHeight = Frame1.ScaleHeight
    Vi.ScreenWidth = Frame1.ScaleWidth
    Vi.ZoomToExtents
    Frame1.Refresh
    Vi.Refresh
    SavetoFile.Enabled = True
    Print1.Enabled = True
    Exit Sub
ErrorHandler:
    MsgBox Err.Description
End Sub
Private Sub Exit_Click()
    On Error GoTo ErrorHandler
    Call Finish
        Unload Me
    Exit Sub
ErrorHandler:
    MsgBox ("Form_Exit " & Err.Description)
End Sub
Private Sub Form_Load()
    On Error GoTo ErrorHandler
    Set objApp = CreateObject("IMSIGX.Application")
    If objApp Is Nothing Then
        MsgBox "Could not start server.  " & Err.Description & "  Quitting."
        Exit Sub
    End If
    Set Drs = objApp.Drawings
    If Drs Is Nothing Then
        MsgBox "Bad server.  " & Err.Description & "  Quitting"
        Exit Sub
    End If
    Exit Sub
ErrorHandler:
    MsgBox ("Form_Load " & Err.Description)
End Sub
Private Sub Form_Paint()
    On Error GoTo ErrorHandler
    If Vi Is Nothing Then
        Exit Sub
    Else
        Vi.ZoomToExtents
    End If
    Exit Sub
ErrorHandler:
    MsgBox ("Form_Paint " & Err.Description)
End Sub
Private Sub Form_Unload(Cancel As Integer)
    On Error GoTo ErrorHandler
    Call Finish
    Exit Sub
ErrorHandler:
    MsgBox ("Form_Unload " & Err.Description)
End Sub
Private Sub Frame1_Paint()
    If Vi Is Nothing Then
        Exit Sub
    Else
        Vi.ZoomToExtents
    End If
End Sub
Private Sub Print1_Click()
    Dim PrintServer As PrintDr
    Dim objDr As Object
    Set PrintServer = New PrintDr
    If (Printers.Count = 0) Then
        MsgBox "There is not printer(s) defined"
        Exit Sub
    End If
    Set objDr = Dr
    Set Printer = Printers(1) ' choose a default printer
    PrintServer.PrintAll Dr, Printer.hDC
End Sub
Private Sub SavetoFile_Click()
    On Error GoTo ErrorHandler
    Dim CadFileSave As String
    CadFileSave = App.Path & "\testcadsave.tcw"
    Dr.SaveAs (CadFileSave)
    MsgBox ("The current drawing is saved to " & App.Path & "\testcadsave.tcw" & " file.")
    Exit Sub
ErrorHandler:
    MsgBox ("FileSave" & Err.Description)
End Sub
Private Sub Finish()
    Set Vi = Nothing
    Set Vis = Nothing
    Set Dr = Nothing
    Set Drs = Nothing
    Set objApp = Nothing
End Sub